allrp <- normc$ext_gene[grep("Rp.*", normc$ext_gene)]
dfcrp <- dfcs_w$ext_gene[grep("Rp.*", dfcs_w$ext_gene)]
rpe <-  normc %>% filter(ext_gene %in% allrp) %>% 
  tibble::column_to_rownames("ext_gene") %>%
  t %>% as_tibble(rownames="cell")
rp <- left_join(Df,rpe,by="cell") %>% gather(-(1:ncol(Df)),key=gene,value=expression)

print(rpe)
print(rp)
M <- rp %>% filter(gene %in% dfcrp) %>% dplyr::group_by(cluster,gene) %>% dplyr::summarise(s=mean(expression))
`summarise()` has grouped output by 'cluster'. You can override using the `.groups` argument.
mm <- M %>% tidyr::pivot_wider(c(gene,cluster,s),names_from=cluster,values_from=s) %>%
  tibble::column_to_rownames("gene")
hmrp <- pheatmap::pheatmap(t(mm),scale="none",color=viridis::viridis(21),border_color = NA)

p1 <- rpe[,colnames(rpe)%in%dfcrp] %>% prcomp()
pca1 <- ggbiplot::ggbiplot(pc,group=Df$Target,scale=0.2,alpha=0.6)+ #xlim(-3,5) +
  theme(legend.position="top")+theme_linedraw()
print(pca1)

p2 <- rpe %>% select(-cell) %>% prcomp()
pca2 <- ggbiplot::ggbiplot(p2,group=Df$Target,scale=0.2,alpha=0.6)+ #xlim(-3,5) +
  theme(legend.position="top")+theme_linedraw()
print(pca2)

matd <- rp %>% filter(cluster==12) %>%
  tidyr::pivot_wider(c(cell,gene,expression),names_from=gene,values_from=expression,values_fill=0) %>%
  tibble::column_to_rownames("cell")
matd_ <- matd[,apply(matd, 2, var, na.rm=TRUE) != 0]
pd3 <- prcomp(matd_)
pca3 <- ggbiplot::ggbiplot(pd3,group=Df$injury[lab.POI],scale=0.2,alpha=0.6)+ #xlim(-3,5) +
  theme(legend.position="top")+theme_linedraw()+discrete_color

print(pca3)

matd <- rp %>% filter(gene %in% dfcrp,cluster==12) %>%
  tidyr::pivot_wider(c(cell,gene,expression),names_from=gene,values_from=expression,values_fill=0) %>%
  tibble::column_to_rownames("cell")
matd_ <- matd[,apply(matd, 2, var, na.rm=TRUE) != 0]
pd4 <- prcomp(matd_)
pca4 <- ggbiplot::ggbiplot(pd4,group=Df$injury[lab.POI],scale=0.2,alpha=0.6)+ #xlim(-3,5) +
  theme(legend.position="top")+theme_linedraw()+discrete_color
print(pca4)

LS0tCnRpdGxlOiAiREZDLVJQcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKCmBgYHtyIGxvYWR9Ck5vcm1jIDwtIHJlYWQudGFibGUoZmlsZT0iL2hvbWUvZ3Vlc3RBL243MDI3NWMvZnVqaS93b3JrL0xvZ2lyZWcvZGF0YS9HU0UxNDM0MzdfRGVNaWNoZWxpX011U0NhdGxhc19ub3JtYWxpemVkZGF0YS50eHQiLCBzZXA9Ilx0IiwgaGVhZGVyPVQsIHJvdy5uYW1lcz0xICkgI3NjYWxlZCBkYXRhCm5vcm1jIDwtIGFzX3RpYmJsZSgoTm9ybWNbdXNlZyxdKSxyb3duYW1lcyA9ICJleHRfZ2VuZSIpCgpsYWIuUE9JIDwtIHJlYWRfY3N2KCJ+L2Z1amkvbGFiUE9JLmNzdiIpICU+JSAuJHZhbHVlCmRmY3MgPC0gcmVhZF9jc3YoIn4vZnVqaS9kZmNzLmNzdiIpIApwcmludChkZmNzKQpgYGAKCmBgYHtyIHByb2Nlc3Npbmd9CmFsbHJwIDwtIG5vcm1jJGV4dF9nZW5lW2dyZXAoIlJwLioiLCBub3JtYyRleHRfZ2VuZSldCmRmY3JwIDwtIGRmY3NfdyRleHRfZ2VuZVtncmVwKCJScC4qIiwgZGZjc193JGV4dF9nZW5lKV0KcnBlIDwtICBub3JtYyAlPiUgZmlsdGVyKGV4dF9nZW5lICVpbiUgYWxscnApICU+JSAKICB0aWJibGU6OmNvbHVtbl90b19yb3duYW1lcygiZXh0X2dlbmUiKSAlPiUKICB0ICU+JSBhc190aWJibGUocm93bmFtZXM9ImNlbGwiKQpycCA8LSBsZWZ0X2pvaW4oRGYscnBlLGJ5PSJjZWxsIikgJT4lIGdhdGhlcigtKDE6bmNvbChEZikpLGtleT1nZW5lLHZhbHVlPWV4cHJlc3Npb24pCgpwcmludChycGUpCnByaW50KHJwKQpgYGAKCmBgYHtyIG1lYW5zIGhlYXRtYXB9Ck0gPC0gcnAgJT4lIGZpbHRlcihnZW5lICVpbiUgZGZjcnApICU+JSBkcGx5cjo6Z3JvdXBfYnkoY2x1c3RlcixnZW5lKSAlPiUgZHBseXI6OnN1bW1hcmlzZShzPW1lYW4oZXhwcmVzc2lvbikpCm1tIDwtIE0gJT4lIHRpZHlyOjpwaXZvdF93aWRlcihjKGdlbmUsY2x1c3RlcixzKSxuYW1lc19mcm9tPWNsdXN0ZXIsdmFsdWVzX2Zyb209cykgJT4lCiAgdGliYmxlOjpjb2x1bW5fdG9fcm93bmFtZXMoImdlbmUiKQpobXJwIDwtIHBoZWF0bWFwOjpwaGVhdG1hcCh0KG1tKSxzY2FsZT0ibm9uZSIsY29sb3I9dmlyaWRpczo6dmlyaWRpcygyMSksYm9yZGVyX2NvbG9yID0gTkEpCmBgYAoKCmBgYHtyIGFsbGNlbGxzIC0gZGZjcnB9CnAxIDwtIHJwZVssY29sbmFtZXMocnBlKSVpbiVkZmNycF0gJT4lIHByY29tcCgpCnBjYTEgPC0gZ2diaXBsb3Q6OmdnYmlwbG90KHBjLGdyb3VwPURmJFRhcmdldCxzY2FsZT0wLjIsYWxwaGE9MC42KSsgI3hsaW0oLTMsNSkgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0idG9wIikrdGhlbWVfbGluZWRyYXcoKQpwcmludChwY2ExKQpgYGAgCgpgYGB7ciBhbGxjZWxscyAtIGFsbHJwfQpwMiA8LSBycGUgJT4lIHNlbGVjdCgtY2VsbCkgJT4lIHByY29tcCgpCnBjYTIgPC0gZ2diaXBsb3Q6OmdnYmlwbG90KHAyLGdyb3VwPURmJFRhcmdldCxzY2FsZT0wLjIsYWxwaGE9MC42KSsgI3hsaW0oLTMsNSkgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0idG9wIikrdGhlbWVfbGluZWRyYXcoKQpwcmludChwY2EyKQpgYGAgCgpgYGB7ciBQT0kgLSBkZmNycH0KbWF0ZCA8LSBycCAlPiUgZmlsdGVyKGNsdXN0ZXI9PTEyKSAlPiUKICB0aWR5cjo6cGl2b3Rfd2lkZXIoYyhjZWxsLGdlbmUsZXhwcmVzc2lvbiksbmFtZXNfZnJvbT1nZW5lLHZhbHVlc19mcm9tPWV4cHJlc3Npb24sdmFsdWVzX2ZpbGw9MCkgJT4lCiAgdGliYmxlOjpjb2x1bW5fdG9fcm93bmFtZXMoImNlbGwiKQptYXRkXyA8LSBtYXRkWyxhcHBseShtYXRkLCAyLCB2YXIsIG5hLnJtPVRSVUUpICE9IDBdCnBkMyA8LSBwcmNvbXAobWF0ZF8pCnBjYTMgPC0gZ2diaXBsb3Q6OmdnYmlwbG90KHBkMyxncm91cD1EZiRpbmp1cnlbbGFiLlBPSV0sc2NhbGU9MC4yLGFscGhhPTAuNikrICN4bGltKC0zLDUpICsKICB0aGVtZShsZWdlbmQucG9zaXRpb249InRvcCIpK3RoZW1lX2xpbmVkcmF3KCkrZGlzY3JldGVfY29sb3IKCnByaW50KHBjYTMpCmBgYAoKYGBge3IgUE9JIC0gYWxscnB9Cm1hdGQgPC0gcnAgJT4lIGZpbHRlcihnZW5lICVpbiUgZGZjcnAsY2x1c3Rlcj09MTIpICU+JQogIHRpZHlyOjpwaXZvdF93aWRlcihjKGNlbGwsZ2VuZSxleHByZXNzaW9uKSxuYW1lc19mcm9tPWdlbmUsdmFsdWVzX2Zyb209ZXhwcmVzc2lvbix2YWx1ZXNfZmlsbD0wKSAlPiUKICB0aWJibGU6OmNvbHVtbl90b19yb3duYW1lcygiY2VsbCIpCm1hdGRfIDwtIG1hdGRbLGFwcGx5KG1hdGQsIDIsIHZhciwgbmEucm09VFJVRSkgIT0gMF0KcGQ0IDwtIHByY29tcChtYXRkXykKcGNhNCA8LSBnZ2JpcGxvdDo6Z2diaXBsb3QocGQ0LGdyb3VwPURmJGluanVyeVtsYWIuUE9JXSxzY2FsZT0wLjIsYWxwaGE9MC42KSsgI3hsaW0oLTMsNSkgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0idG9wIikrdGhlbWVfbGluZWRyYXcoKStkaXNjcmV0ZV9jb2xvcgpwcmludChwY2E0KQpgYGAKCg==